delphi 开发手机客户端连接PC服务器端进行数据查询服务 
PC服务器端代码
unit Unit1;
interface
uses Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, IniFiles,
System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Data.DB,
Data.Win.ADODB, Datasnap.Provider, Vcl.Grids, Vcl.DBGrids, Vcl.StdCtrls;
type
TForm1 = class(TForm)
DBGrid1: TDBGrid;
DataSource1: TDataSource;
Button1: TButton;
Edit1: TEdit;
procedure FormShow(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
uses ServerContainerUnit1, ServerMethodsUnit1;
procedure TForm1.Button1Click(Sender: TObject);
begin
sTopNumber:= Edit1.Text;
end;
procedure TForm1.FormCreate(Sender: TObject);
var
IniFile: TIniFile;
begin
IniFile:= TIniFile.Create(ExtractFilePath(ParamStr(0)) 'MyServer.ini');
try
strConnStr:= IniFile.ReadString('SYSTEM', 'DBConnStr', '');
finally
FreeAndNil(IniFile);
end;
if strErr <> '' then
Edit1.Text:= strErr;
end;
procedure TForm1.FormShow(Sender: TObject);
begin
case DBFlag of
1:
MessageBox(Handle, PChar('数据源连接失败-conn！错误信息：' #13#10 strErr),
PChar('错误'), MB_IconError MB_OK);
2:
MessageBox(Handle, PChar('数据源连接失败-table！错误信息：' #13#10 strErr),
PChar('错误'), MB_IconError MB_OK);
3:
MessageBox(Handle, PChar('数据源连接成功!' #13#10 strErr),
PChar('成功'), MB_IconInformation MB_OK);
end;
end;
end.
unit ServerMethodsUnit1;
interface
uses System.SysUtils, System.Classes, System.Json, Variants,
Datasnap.DSServer, Datasnap.DSAuth, DataSnap.DSProviderDataModuleAdapter,
Data.DB, Data.Win.ADODB, Datasnap.Provider, Datasnap.DBClient;
type
TServerMethods1 = class(TDSServerModule)
DataSetProvider1: TDataSetProvider;
Conn: TADOConnection;
ADOQuery1: TADOQuery;
ClientDataSet1: TClientDataSet;
procedure DSServerModuleCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
function EchoString(Value: string): string;
function ReverseString(Value: string): string;
//获取数据，参数为sql语句
function MyGetData(const strSQL: string): OleVariant;
end;
var
DBFlag: integer;
strErr: String = '';
sTopNumber: string = '10';
strConnStr: string = '';
implementation
{$R *.dfm}
uses System.StrUtils, Unit1;
procedure TServerMethods1.DSServerModuleCreate(Sender: TObject);
begin
strErr:= 'OK!';
Conn.Close;
Conn.ConnectionString:= strConnStr;
try
Conn.Connected:= True;
strErr:= '22222222222222';
except
on e: Exception do
begin
//MessageBox(Handle, PChar('数据源连接失败！错误信息：' #13#10 e.Message), PChar('错误'), MB_IconError MB_OK);
DBFlag:= 1;
strErr:= e.Message;
Form1.Edit1.Text:= strErr;
Exit;
end;
end;
try
ADOQuery1.Close;
ADOQuery1.SQL.Text:= 'select top ' sTopNumber ' * from CALL_RECORD';
ADOQuery1.Open;
strErr:= '11111111111111';
except
on e: Exception do
begin
//MessageBox(Handle, PChar('数据源连接失败！错误信息：' #13#10 e.Message), PChar('错误'), MB_IconError MB_OK);
DBFlag:= 2;
strErr:= e.Message;
Form1.Edit1.Text:= strErr;
Exit;
end;
end;
Form1.Edit1.Text:= strErr;
DBFlag:= 3;
end;
function TServerMethods1.EchoString(Value: string): string;
begin
Result := Value;
end;
function TServerMethods1.MyGetData(const strSQL: string): OleVariant;
begin
ClientDataSet1.Close;
try
ADOQuery1.Close;
ADOQuery1.SQL.Text:= strSQL;
ADOQuery1.Open;
ClientDataSet1.Open;
except
on e: exception do
begin
Result:= Unassigned;
strErr:= 'MyGetData error 1';
Form1.Edit1.Text:= strErr;
Exit;
end;
end;
strErr:= 'MyGetData OK 1';
Form1.Edit1.Text:= strErr;
Result:= ClientDataSet1.Data;
end;
function TServerMethods1.ReverseString(Value: string): string;
begin
Result := System.StrUtils.ReverseString(Value);
end;
end.
unit ServerContainerUnit1;
interface
uses System.SysUtils, System.Classes,
Datasnap.DSTCPServerTransport,
Datasnap.DSServer, Datasnap.DSCommonServer,
Datasnap.DSAuth, IPPeerServer, Data.DB, Data.Win.ADODB, Datasnap.Provider;
type
TServerContainer1 = class(TDataModule)
DSServer1: TDSServer;
DSTCPServerTransport1: TDSTCPServerTransport;
DSServerClass1: TDSServerClass;
procedure DSServerClass1GetClass(DSServerClass: TDSServerClass;
var PersistentClass: TPersistentClass);
private
{ Private declarations }
public
end;
var
ServerContainer1: TServerContainer1;
DBFlag: Boolean;
strErr: String;
implementation
{$R *.dfm}
uses Winapi.Windows, ServerMethodsUnit1;
procedure TServerContainer1.DSServerClass1GetClass(
DSServerClass: TDSServerClass; var PersistentClass: TPersistentClass);
begin
PersistentClass := ServerMethodsUnit1.TServerMethods1;
end;
end.
手机客户端代码
unit UnMain;
interface
uses
System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.StdCtrls,
FMX.Controls.Presentation, FMX.Edit, System.Rtti, FMX.Layouts, FMX.Grid,
Data.Bind.EngExt, Fmx.Bind.DBEngExt, Fmx.Bind.Grid, System.Bindings.Outputs,
Fmx.Bind.Editors, Data.Bind.Components, Data.Bind.Grid, Data.Bind.DBScope,
Data.DBXDataSnap, IPPeerClient, Data.DBXCommon, Data.DB, Datasnap.DBClient,
Datasnap.DSConnect, Data.SqlExpr, FMX.Grid.Style, FMX.ScrollBox;
type
TForm2 = class(TForm)
edtIP: TEdit;
edtPort: TEdit;
Label1: TLabel;
Label2: TLabel;
Button1: TButton;
BindSourceDB1: TBindSourceDB;
BindingsList1: TBindingsList;
BindingsList2: TBindingsList;
Grid1: TGrid;
CheckBox1: TCheckBox;
Button2: TButton;
BindSourceDB2: TBindSourceDB;
LinkGridToDataSourceBindSourceDB1: TLinkGridToDataSource;
Label3: TLabel;
edtTableName: TEdit;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form2: TForm2;
implementation
{$R *.fmx}
{$R *.LgXhdpiPh.fmx ANDROID}
{$R *.SmXhdpiPh.fmx ANDROID}
{$R *.NmXhdpiPh.fmx ANDROID}
uses UnDM, Unit2;
procedure TForm2.Button1Click(Sender: TObject);
var
dm : TServerMethods1Client;
begin
try
//连接指定IP和Port的应用服务器
dmMain.SQLConn.Close;
dmMain.SQLConn.Params.Values['HostName'] := edtIP.Text;
dmMain.SQLConn.Params.Values['Port'] := edtPort.Text;
try
dmMain.SQLConn.Open;
try
//创建应用服务器上的Sample Methods在客户端的实现类
dm := TServerMethods1Client.Create(dmMain.SQLConn.DBXConnection);
//执行服务器上的方法
if CheckBox1.IsChecked then
ShowMessage(dm.ReverseString(edtIP.Text));
finally
dm.Free;
end;
//开启客户端数据集
dmMain.cdsDataSet.Close;
// dmMain.cdsDataSet.CommandText:= 'select * from OrderPrefix_Tab';
dmMain.cdsDataSet.Open;
except
on E: Exception do
ShowMessage(E.Message);
end;
finally
dmMain.SQLConn.Close;
end;
end;
procedure TForm2.Button2Click(Sender: TObject);
var
dm : TServerMethods1Client;
tmpOleVar: OleVariant;
begin
dmMain.cdsDataSet.Close;
try
//连接指定IP和Port的应用服务器
dmMain.SQLConn.Close;
dmMain.SQLConn.Params.Values['HostName'] := edtIP.Text;
dmMain.SQLConn.Params.Values['Port'] := edtPort.Text;
try
dmMain.SQLConn.Open;
try
//创建应用服务器上的Sample Methods在客户端的实现类
dm := TServerMethods1Client.Create(dmMain.SQLConn.DBXConnection);
//执行服务器上的方法
tmpOleVar:= dm.MyGetData('select * from ' edtTableName.Text);
finally
dm.Free;
end;
if VarIsEmpty(tmpOleVar) then
begin
ShowMessage('查询结果为空！');
Exit;
end;
dmMain.cdsDataSet.Data:= tmpOleVar;
except
on E: Exception do
ShowMessage(E.Message);
end;
finally
dmMain.SQLConn.Close;
end;
end;
end.
unit Unit2;
interface
uses System.JSON, Data.DBXCommon, Data.DBXClient, Data.DBXDataSnap, Data.DBXJSON, Datasnap.DSProxy, System.Classes, System.SysUtils, Data.DB, Data.SqlExpr, Data.DBXDBReaders, Data.DBXCDSReaders, Data.DBXJSONReflect;
type
TServerMethods1Client = class(TDSAdminClient)
private
FDSServerModuleCreateCommand: TDBXCommand;
FEchoStringCommand: TDBXCommand;
FReverseStringCommand: TDBXCommand;
FMyGetDataCommand: TDBXCommand;
public
constructor Create(ADBXConnection: TDBXConnection); overload;
constructor Create(ADBXConnection: TDBXConnection; AInstanceOwner: Boolean); overload;
destructor Destroy; override;
procedure DSServerModuleCreate(Sender: TObject);
function EchoString(Value: string): string;
function ReverseString(Value: string): string;
function MyGetData(strSQL: string): OleVariant;
end;
implementation
procedure TServerMethods1Client.DSServerModuleCreate(Sender: TObject);
begin
if FDSServerModuleCreateCommand = nil then
begin
FDSServerModuleCreateCommand := FDBXConnection.CreateCommand;
FDSServerModuleCreateCommand.CommandType := TDBXCommandTypes.DSServerMethod;
FDSServerModuleCreateCommand.Text := 'TServerMethods1.DSServerModuleCreate';
FDSServerModuleCreateCommand.Prepare;
end;
if not Assigned(Sender) then
FDSServerModuleCreateCommand.Parameters[0].Value.SetNull
else
begin
FMarshal := TDBXClientCommand(FDSServerModuleCreateCommand.Parameters[0].ConnectionHandler).GetJSONMarshaler;
try
FDSServerModuleCreateCommand.Parameters[0].Value.SetJSONValue(FMarshal.Marshal(Sender), True);
if FInstanceOwner then
Sender.Free
finally
FreeAndNil(FMarshal)
end
end;
FDSServerModuleCreateCommand.ExecuteUpdate;
end;
function TServerMethods1Client.EchoString(Value: string): string;
begin
if FEchoStringCommand = nil then
begin
FEchoStringCommand := FDBXConnection.CreateCommand;
FEchoStringCommand.CommandType := TDBXCommandTypes.DSServerMethod;
FEchoStringCommand.Text := 'TServerMethods1.EchoString';
FEchoStringCommand.Prepare;
end;
FEchoStringCommand.Parameters[0].Value.SetWideString(Value);
FEchoStringCommand.ExecuteUpdate;
Result := FEchoStringCommand.Parameters[1].Value.GetWideString;
end;
function TServerMethods1Client.ReverseString(Value: string): string;
begin
if FReverseStringCommand = nil then
begin
FReverseStringCommand := FDBXConnection.CreateCommand;
FReverseStringCommand.CommandType := TDBXCommandTypes.DSServerMethod;
FReverseStringCommand.Text := 'TServerMethods1.ReverseString';
FReverseStringCommand.Prepare;
end;
FReverseStringCommand.Parameters[0].Value.SetWideString(Value);
FReverseStringCommand.ExecuteUpdate;
Result := FReverseStringCommand.Parameters[1].Value.GetWideString;
end;
function TServerMethods1Client.MyGetData(strSQL: string): OleVariant;
begin
if FMyGetDataCommand = nil then
begin
FMyGetDataCommand := FDBXConnection.CreateCommand;
FMyGetDataCommand.CommandType := TDBXCommandTypes.DSServerMethod;
FMyGetDataCommand.Text := 'TServerMethods1.MyGetData';
FMyGetDataCommand.Prepare;
end;
FMyGetDataCommand.Parameters[0].Value.SetWideString(strSQL);
FMyGetDataCommand.ExecuteUpdate;
Result := FMyGetDataCommand.Parameters[1].Value.AsVariant;
end;
constructor TServerMethods1Client.Create(ADBXConnection: TDBXConnection);
begin
inherited Create(ADBXConnection);
end;
constructor TServerMethods1Client.Create(ADBXConnection: TDBXConnection; AInstanceOwner: Boolean);
begin
inherited Create(ADBXConnection, AInstanceOwner);
end;
destructor TServerMethods1Client.Destroy;
begin
FDSServerModuleCreateCommand.DisposeOf;
FEchoStringCommand.DisposeOf;
FReverseStringCommand.DisposeOf;
FMyGetDataCommand.DisposeOf;
inherited;
end;
end.
技术交流：QQ 58570143
评论